home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
nghelp.zip
/
NG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-02
|
16KB
|
649 lines
{$A+,B-,E+,F-,I-,N-,O-,R-,V-}
{$UNDEF DEBUG}
{$IFDEF DEBUG} {$D+,L+,S+} {$ELSE} {$D-,L-,S-} {$ENDIF}
Unit Ng;
Interface
Const ShortEntry = 0;
LongEntry = 1;
NoEntry = $ffff;
Type Str79 = String[79];
Str84 = String[84];
Str100 = String[100];
Str160 = String[160];
Str255 = String[255];
StrPtr = ^Str84;
{**********De Objecten*******************************************************}
GuideMenuOBJ = Object
Count : Word; {Aantal Pulldownmenus in dit Menu,Contructor}
Title : Str84;
{********Pointers***************************}
Entrys : Array [1..10] of Longint;
Lines : Array [1..10] of StrPtr;
{*******************************************}
Procedure Load(L : Longint); {Laad menuEntry}
Procedure Done;{voor straks Desctructor}
Function Entry(Nr : Word) : Longint; {Zie MMEntry}
Function Line(Nr : Word) : Str84;
End; {GuideMenuOBJ}
{****************************************************************************}
GuideShortOBJ = Object
Count : Word; {Aantal regels, 0 als fout is opgetreden}
Parent : Longint; {Geeft ouders van ouder in short}
Current : Word; {Current Entry,Eigenlijk +1, Als Parent -1}
{dan Current 65536 }
MenuParent : Word; {als Parent -1 dan is dit het Menu Nummer}
{Eerste Menu is 0}
MenuLine : Word; {Als Parent -1 Dan dit Regelnummer van menu}
{Eerste Regel is 0}
{********Pointers***************************}
Entrys : Array [1..512] of Longint;
Lines : Array [1..512] of StrPtr;
{*******************************************}
Procedure Load(L : Longint); {laad een short entry}
Procedure Done; {Voor later met destructor}
Function Line(Nr : Word) : Str84;
Function RawLine(Nr : Word) : Str84;
Function Entry(Nr : Word) : Longint;
End; {GuideShortOBJ}
{****************************************************************************}
SeeAlsoOBJ = Object
Count : Word;
{********Pointers***************************}
Entrys : Array [1..21] of Longint;
Lines : Array [1..21] of StrPtr;
{*******************************************}
Procedure Done;
Function Line(Nr : Word) : Str84;
Function Entry(Nr : Word) : Longint;
End; {SeeAlso}
{----------------------------------------------------------------------------}
GuideLongOBJ = Object
SeeAlso : SeeAlsoObj;
Count : Word; {Aantal Regels}
Parent : Longint; {Als -1 dan geen parent}
Current : Word; {Als 65535 dan geen Current}
MenuParent : Word; {Let op menu 4 = Menu 0}
MenuLine : Word; {Begint bij 0 net als boven}
PrevEntry : Longint; {-1 geen previous}
NxtEntry : Longint; {-1 geen next}
{********Pointers***************************}
Lines : Array [1..512] of StrPtr;
{*******************************************}
Procedure Load(L : Longint);
Procedure Done;
Function Line(Nr : Word) : Str84;
Function RawLine(Nr : Word) : Str84;
Function Previous : Longint;
Function Next : Longint;
End; {GuideLongOBJ}
{**********Einde van de Objecten*********************************************}
Var GuideName : Str84;
Menus : Byte; {De aantal topmenus}
{**Algemeen voor NG**********************************************************}
Function LookGuide(F : String) : String;
Function OpenGuide(GuideFileName : Str79) : Boolean;
Procedure CloseGuide;
Function Credit(Regel : Byte) : Str160;
Function MenuEntry(Nr : Byte) : Longint;
Function EntryType(L : Longint) : Word;
Function GuideStrip(S : String) : String;
Function FirstEntry : Longint;
{****************************************************************************}
Implementation
{Algemeen gebruikte variabelen}
{Geen object omdat NG.TPU Maar een NG file Open per keer aankan}
Var DecrypTabel : Array [0..255] of Byte;
Guide : File; {File variabele voor Norton Guide}
MEntry : Array [1..10] of Longint; {Geeft MenuEntrys voor Menuobj.Load}
Credits : Array [1..5] of StrPtr;{voor funtie Credit}
Buffer : Array [0..377] of Byte;
UpDateBuffer : Boolean;
FileBufStart : Longint;
FilePtr : Longint;
FileBufEnd : Longint;
{***Niet voor eind user maar voor intern, menuobj****************************}
{----------------------------------------------------------------------------}
{**Algemeen Voor Norton Guide*************************************************}
Procedure MoveFilePtr(L : Longint);
{deze procedure doet een normale seek, is gedaan om bij eventueele fout
controle dit hier te inplanteren. FilePtr wordt ook geupdate omdat enkele
funties hier vanaf hangen(bv:GuideShortOBJ.load de Entrys Lezen)}
Begin
Seek(Guide,L);
if (L>=FileBufStart) And (L<=FileBufEnd) then FilePtr := L
Else UpDateBuffer := True;
End;
Procedure ReadBuffer;
Var Result : Word;
Begin
if Not UpDateBuffer then Seek(Guide,FilePtr);
UpDateBuffer := False;
FileBufStart := FilePos(Guide);
FilePtr := FileBufStart;
BlockRead(Guide,Buffer,Sizeof(Buffer),Result);
FileBufEnd := FilePtr + Pred(Result);
End;
Procedure MakeDecrypTabel;
Function Decrypt(B : Byte) : Byte;
{Decrypt byte from NG format}
Begin
if ((B Mod 32)>=16) then B := B - 16 Else B := B + 16;
if ((B Mod 16)>=8) then B := B - 8 Else B := B + 8;
if ((B Mod 4)>=2) then B := B - 2 Else B := B + 2;
Decrypt := B;
End;
Var Loop : Byte;
Begin
For Loop := 0 to 255 Do DecrypTabel[Loop] := Decrypt(Loop);
End;
Function Read_Byte : Byte;
{Read and decrypt byte}
Var Tb : Byte;
Begin
if (FilePtr>FileBufEnd) Or (UpDateBuffer) then
Begin
ReadBuffer;
End;
Tb := DecrypTabel[Buffer[FilePtr-FileBufStart]];
Inc(FilePtr);
Read_Byte := Tb;
End;
Function Read_Word : Word;
{Read and decrypt word}
Var Tw : Word;
Tb : Byte;
Begin
Tb := Read_Byte;
Tw := Tb;
Tb := Read_Byte;
Inc(tw,(Tb*256));
Read_Word := Tw;
End;
Function Read_Long : Longint;
{Read and decrypt longint}
Var Tl : Longint;
Tw : Word;
Begin
Tw := Read_Word;
Tl := Tw;
Tw := Read_Word;
Inc(Tl,(Tw*65536));
Read_Long := Tl;
End;
{******************Eind Norton Algemeen**************************************}
{*****Normale Functies en Procedures*****************************************}
Procedure CloseGuide;
Var Loop : Byte;
Begin
{$I-} Close(Guide); {$I+}
if IOResult <> 0 then ; {Alleen opvangen}
For Loop := 1 to 5 Do
if Credits[Loop]<>Nil then FreeMem(Credits[Loop],Length(Credits[Loop]^)+1);
End;
Function FirstEntry : Longint;
Begin
FirstEntry := 378;
End;
Function LookGuide(F : String) : String;
Var S : String;
Loop : Word;
Result : Word;
Guide : File;
Begin
LookGuide := ''; UpDateBuffer := True;
if F = '' then Exit;
Assign(Guide,F);
{$I-} Reset(Guide,1); {$I+}
if IOResult <> 0 then Exit; {File bestaat niet}
BlockRead(Guide,Buffer,378,Result);
if (Buffer[0]<>78) Or (Buffer[1]<>71)
Or (Result<>Sizeof(Buffer)) then
{Als de eerste 2 char niet 'NG' zijn of file is te klein dan geen NortonGuide}
Begin
Close(Guide);
Exit;
End;
Menus := Buffer[6];
Loop := 0;
Repeat
S[Loop+1] := Chr(Buffer[Loop+8]);
Inc(Loop);
Until (Buffer[Loop+8]=0);
S[0] := Chr(Loop); {Lengte Van de GuideName}
LookGuide := S;
Close(Guide);
End;
Function OpenGuide(GuideFileName : Str79) : Boolean;
Var Loop : Word;
Procedure GetCredits;
Var Loop2 : Byte;
Len : Byte;
S : String;
Begin
Loop := 48;
For Loop2 := 1 to 5 Do
Begi